Developer CD Series 1992 June: ROMin Holiday/ADC Developer CD (1992-06) (''ROMin Holiday'')_iso/Developer Connection - 06-1992.iso/Development Platforms/Apple II/Apple II Sample Code/MPW IIGS SC/SC.024.Teach/teach.p/uWindow.inc.p

Text File | 1990-06-24 | 11.9 KB | 483 lines | [TEXT/MPS ]

{**********************************************************************
{*
{* Teach uWindow.inc.p -- Version 3.0  (implementation)
{*
{* Copyright (c)
{* Apple Computer, Inc.  1986-1990
{* All Rights Reserved.
{*
{* Developer Technical Support Apple II Sample Code
{*
{* This file contains the code which implements
{* windows in the Teach program.
{*
{**********************************************************************}
{$R-}



PROCEDURE Debug;  INLINE $0000;


{***********************************************************************
*
* smartGetWTitle
*
* This function returns a pointer to the window title pascal string.
* This is a little more complicated than it used to be, given that
* NewWindow2 clones the string for the window into an unlocked handle.
* GetWTitle returns a handle with the hi-bit set (to distinguish it
* from a reguler pointer).  If the hi-bit is set, then we want to
* dereference the handle to a pointer, and return that instead.
*
***********************************************************************}
function smartGetWTitle(wptr : GrafPortPtr): StringPtr;

var    wtitle : Ptr;

begin
    wtitle := GetWTitle(wptr);
    if (BAND4(longint(wtitle),$80000000) <> 0)
        then wtitle := Handle(BAND4(longint(wtitle), $7FFFFFFF))^;
    smartGetWTitle := StringPtr(wtitle);
end;

{**********************************************************************}
{
{ drawThisWindow
{
{ This routine draws the contents of all the windows.
{
{**********************************************************************}
procedure drawThisWindow;
    begin
        DrawControls(GetPort);
    END;

{**********************************************************************}
{
{ doCloseTop
{
{ This routine closes the topmost window.  We do a little work to
{ prevent the main window from being closed.
{
{**********************************************************************}
procedure doCloseTop;
    var
        refCon    : Longint;

    begin
        refCon := GetWRefCon(FrontWindow);
        { Get rid of the path name handle that we keep in the refcon. }
        { Note that it is zero if the window is untitled }
        if refCon <> 0 then DisposeHandle(handle(refCon));

        { Close the window.  (This kills the window title handle.) }
        CloseWindow(FrontWindow);
    end;

{**********************************************************************}
{
{ putFileIntoWindow
{
{ This routine opens the specified file, reads its contents in and
{ sets the text of the text edit control of the top window to that text
{
{**********************************************************************}
procedure    putFileIntoWindow (c1Hndl : handle);
    var
        openBlock : OpenRecGS;
        closeBlock : RefNumRecGS;
        readBlock : IORecGS;
        theHndl : handle;
        temp : integer;

    begin
        with openBlock do begin
            pCount := 15;
            pathname := GSString255Ptr(c1Hndl^);
            requestAccess := 0;
            resourceNumber := 0;
            optionList := NIL;
        end;

        OpenGS (OpenBlock);
        if _toolErr <> 0 then
            begin
                temp := ErrorWindow(0,c1Hndl^,_ToolErr);
                exit(putfileIntoWindow);
            end;

        with CloseBlock do begin
            pCount := 1;
            refNum := OpenBlock.refNum;
        end;

        theHndl := NewHandle (openBlock.eof,userID,0,NIL);
        if _toolErr <> 0 then
            begin
                temp := ErrorWindow(0,c1Hndl^,_ToolErr);
                CloseGS(closeBlock);
                exit(putfileIntoWindow);
            end;

        HLock (theHndl);

        with readBlock do begin
            pCount := 4;
            refNum := openBlock.refNum;
            DataBuffer := theHndl^;
            requestCount := openBlock.eof;
        end;
        ReadGS (readBlock);
        if _toolErr <> 0 then
            begin
                temp := ErrorWindow(0,c1Hndl^,_ToolErr);
                DisposeHandle(theHndl);
                CloseGS(CloseBlock);
                exit(putfileIntoWindow);
            end;

        CloseGS (CloseBlock);
        if _ToolErr <> 0 then
            begin
                temp := ErrorWindow(0,c1Hndl^,_ToolErr);
                DisposeHandle(theHndl);
                exit(putfileIntoWindow);
            end;


        TESetText (
            teDataIsTextBlock+refIsHandle*8,                { Text Descriptor }
            TETextRef(theHndl),                                 { Text Ref }
            0,                                                  { Text Length }
            0,                                                  { Style Descriptor }
            TEStyleRef(0),                                    { Style Ref }
            TERecordHndl(GetCtlHandleFromID(
                            FrontWindow,MainWindowID))        { Control Handle }
            );

        DisposeHandle(theHndl);

    end;

{**********************************************************************}
{
{ putWindowIntoFile
{
{ This routine opens the specified file, writes the window contents.
{
{**********************************************************************}
procedure    putWindowIntoFile (c1Hndl : Handle);
    var
        destroyBlock : NameRecGS;
        createBlock  : CreateRecGS;
        openBlock      : OpenRecGS;
        closeBlock      : RefNumRecGS;
        writeBlock      : IORecGS;
        theHndl      : Handle;
        temp, err     : Integer;
        totalSize      : LongInt;

    begin
        with DestroyBlock do begin
            pCount := 1;
            pathname := GSString255Ptr(c1Hndl^);
        end;

        DestroyGS(DestroyBlock);
        if _toolErr <> 0
            then if _toolErr <> fileNotFound then
                begin
                    temp := ErrorWindow(0,c1Hndl^, _toolErr);
                    exit(putWindowIntoFile);
                end;

        with CreateBlock do Begin
            pCount := 4;
            pathname := GSString255Ptr(c1Hndl^);
            access := $C3;
            fileType := $04;
            AuxType := 0;
        end;

        CreateGS (CreateBlock);
        if _ToolErr <> 0 then
            begin
                temp := ErrorWindow(0,c1Hndl^,_ToolErr);
                exit(PutWindowIntoFile);
            end;

        with OpenBlock do begin
            pCount := 15;
            pathname := GSString255Ptr(c1Hndl^);
            requestAccess := 0;
            resourceNumber := 0;
            optionList := NIL;
        end;

        OpenGS (OpenBlock);
        err := _toolErr;
        if err <> 0 then
            begin
                DestroyGS(destroyBlock);
                temp := ErrorWindow(0,c1Hndl^,err);
                exit(PutWindowIntoFile);
            end;

        with CloseBlock do begin
            pCount := 1;
            refNum := openBlock.refNum;
        end;

        theHndl := NewHandle(1, userID, 0, NIL);

        if _toolErr = 0 then
            totalSize := TEGetText (
                            teDataIsTextBlock+refIsHandle*8,                      { Text Descriptor }
                            TETextRef(theHndl),                                     { Text Ref }
                            0,                                                      { Text Length }
                            0,                                                      { Style Descriptor }
                            TEStyleRef(0),                                        { Style Ref }
                            TERecordHndl(
                                GetCtlHandleFromID(FrontWindow,MainWindowID)
                                        ))                                       { Control Handle }
        else theHndl := NIL;

        err := _toolErr;
        if err <> 0 then
            begin
                if theHndl <> NIL then DisposeHandle(theHndl);
                CloseGS(CloseBlock);
                DestroyGS(destroyBlock);
                temp := ErrorWindow(0,c1Hndl^,err);
                exit(putWindowIntoFile);
            end;

        HLock (theHndl);
        with WriteBlock do begin
            pCount := 4;
            refNum := OpenBlock.refNum;
            dataBuffer := theHndl^;
            requestCount := totalSize;
        end;
        WriteGS (writeBlock);
        err := _toolErr;
        DisposeHandle(theHndl);
        if err <> 0 then
            begin
                CloseGS(closeBlock);
                DestroyGS(destroyBlock);
                temp := ErrorWindow(0,c1Hndl^,err);
                exit(PutWindowIntoFile);
            end;

        CloseGS (CloseBlock);
        err := _toolErr;
        if err <> 0 then
            begin
                DestroyGS(destroyBlock);
                temp := ErrorWindow(0,c1Hndl^,err);
            end;
    end;


{**********************************************************************}
{
{ placeAndShowWindow
{
{ This routine moves the specified window based on stagger count
{ and shows it.
{
{**********************************************************************}
procedure placeAndShowWindow (theWindow : GrafPortPtr);

    begin
        MoveWindow (8+8*staggerCount,28+8*staggerCount,theWindow);
        staggerCount := staggerCount+1;
        ShowWindow(theWindow);
        SelectWindow(theWindow);
    end;

{****************************************************************************}
{
{ doOpenWindow
{
{ This routine either asks the user what file to open and opens it.
{
{****************************************************************************}
procedure doOpenWindow;
    var
        myReply    : SFReplyRec2;
        wptr    : GrafPortPtr;
        myPrompt: string;

    begin
        myPrompt := 'Pick a file, any file.';

        SFAllCaps (true);

        myReply.nameRefDesc := refIsNewHandle;
        myReply.pathRefDesc := refIsNewHandle;
        SFGetFile2 (10,35,
                    RefIsPointer,
                    Ref(@myPrompt),
                    NIL,        {filter proc}
                    NIL,        {type list}
                    myReply );


        if myReply.good then
            begin
                { Convert the C1Output string into a C1Input string for the resource mangager }
                C1OutputToC1Input(myReply.pathRef.RefIsHandle);

                C1OutputToPString(myReply.nameRef.RefIsHandle);

                HLock(myReply.nameRef.RefIsHandle);

                wptr := NewWindow2    (StringPtr(myReply.nameRef.RefIsHandle^),            { Title reference}
                                     longint(myReply.pathRef.RefIsHandle),        { Ref con }
                                     @DrawThisWindow,                            { Draw routine }
                                     NIL,                                        { DefProc pointer }
                                     RefIsResource,                                { Param Table Descriptor }
                                     ref(MainWindowID),                            { Param Table Reference }
                                     rWindParam1);                                { Param Table Type }

                { Get rid of this handle }
                DisposeHandle(myReply.nameRef.RefIsHandle);

                placeAndShowWindow(wptr);

                putFileIntoWindow(myReply.pathRef.RefIsHandle);
            end;

    end;


{****************************************************************************}
{
{ doSaveAs
{
{ This routine saves the file  in the place indicated by the user.
{
{****************************************************************************}
procedure doSaveAs;
    var
        myPrompt : String;
        myReply : SFReplyRec2;
        origWinTitle : StringPtr;
        newWinTitle : Handle;
        temp : LongInt;

    begin;
        MyPrompt := 'Give it a name, any name.';
        SFAllCaps (true);

        myReply.nameRefDesc := refIsNewHandle;
        myReply.pathRefDesc := refIsNewHandle;

        { The current window title is the default name }
        origWinTitle := smartGetWTitle(FrontWindow);

        { Get a C1String in  a new handle }
        newWinTitle := PStringToNewC1String(origWinTitle);

        HLock(newWinTitle);

        SFPutFile2 (180,35,
                    refIsPointer,
                    Ref(@MyPrompt),
                    refIsPointer,
                    Ref(newWinTitle^),
                    MyReply );

        { Don't need this default name any more }
        DisposeHandle(newWinTitle);

        if myReply.good then
            begin
                { Get rid of old path name handle in RefCon }
                DisposeHandle(Handle (GetWRefCon(FrontWindow)));

                { Convert the C1Output string into a C1Input string for the resource mangager }
                C1OutputToC1Input(myReply.pathRef.RefIsHandle);

                { Save the path name in the refcon of the window }
                SetWRefCon(LongInt(myReply.pathRef.RefIsHandle),FrontWindow);

                { Convert this C1 Output string into a pString for the window manager }
                C1OutputToPString(myReply.nameRef.RefIsHandle);

                SetWTitle (String255Ptr(myReply.nameRef.RefIsHandle^)^,FrontWindow);
                DisposeHandle(myReply.nameRef.RefisHandle);

                { Write the file out to disk }
                putWindowIntoFile(myReply.pathRef.RefIsHandle);
            end;

    end;


{****************************************************************************}
{
{ doSave
{
{ This routine either saves the file (unless it is new then it does a save
{ as).
{
{****************************************************************************}
procedure doSave;
    var
        wptr : GrafPortPtr;
        refCon : LongInt;

    begin

        wptr := FrontWindow;
        refCon := GetWRefCon(wptr);

        if refCon = 0 then doSaveAs
        else  putWindowIntoFile(handle(refCon));
    end;




{****************************************************************************}
{
{ doNewWindow
{
{ This routine opens a new untitled window.
{
{****************************************************************************}
procedure    doNewWindow;
    var
        wptr : GrafPortPtr;
        tempStr : Str255;
    begin
        tempStr := 'Untitled';
        wptr := NewWindow2    (StringPtr(@tempStr),            { Title reference}
                             0,                        { Ref con }
                             @drawThisWindow,        { Draw routine }
                             NIL,                    { DefProc pointer }
                             RefIsResource,            { Param Table Descriptor }
                             Ref(MainWindowID),        { Param Table Reference }
                             rWindParam1);            { Param Table Type }

        placeAndShowWindow(wptr);

    end;
{*****************************************************************************}
{
{ setUpWindows
{
{ Opens the default window.
{
{*****************************************************************************}
procedure setUpWindows;
    begin   {of SetUpWindows}
        doNewWindow;
    end;    {of SetUpWindows}